home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / os2 / foss11b3.zip / DEVELOP / UTILCOLL / UPDFILE.PAS < prev   
Pascal/Delphi Source File  |  1996-02-29  |  9KB  |  315 lines
  1. {$M 16384,0,655360}
  2. program UpdFile;
  3. uses
  4.   ApiInt, Types,
  5.   TParam,
  6.   Bits,
  7.   DOS, Crt;
  8.  
  9. type
  10.   PUpdFiles        = ^TUpdFiles;
  11.   TUpdFiles        = object
  12.     SkipDate       : Boolean;
  13.     SkipSize       : Boolean;
  14.     CheckExist     : Boolean;
  15.     CheckAction    : ( actAutofix, actDelete, actAutofixLong  );
  16.     AreaCode       : string;
  17.     FileSpec       : string;
  18.     Cfg            : SysCfgT;
  19.  
  20.     constructor Init;
  21.     destructor Done;
  22.  
  23.     procedure ReadParams;
  24.     procedure UpdateFiles;
  25.   end;
  26.  
  27. var
  28.   UpdFiles         : PUpdFiles;
  29.  
  30. constructor TUpdFiles.Init;
  31. begin
  32.   dllInit( '', 0 );
  33.   fioReadMainCfg( Cfg );
  34. end;
  35.  
  36. destructor TUpdFiles.Done;
  37. begin
  38. end;
  39.  
  40. procedure TUpdFiles.ReadParams;
  41. begin
  42.   if Par^.SwAct['C'] then
  43.   begin
  44.     CheckExist := TRUE;
  45.     case S2C( UpStr( Par^.SwStr['C'] )) of
  46.       'A': CheckAction := actAutofix;
  47.       'D': CheckAction := actDelete;
  48.       'L': CheckAction := actAutofixLong;
  49.     else
  50.       CheckExist := FALSE;
  51.     end;
  52.   end
  53.   else CheckExist := FALSE;
  54.  
  55.   if Par^.SwAct['D'] then SkipDate := TRUE
  56.   else SkipDate := FALSE;
  57.  
  58.   if Par^.SwAct['S'] then SkipSize := TRUE
  59.   else SkipSize := FALSE;
  60.  
  61.   if Par^.SwAct['A'] then AreaCode := Par^.SwStr['A']
  62.   else AreaCode := 'MAIN';
  63.  
  64.   FileSpec := UpStr( Par^.Str[1] );
  65. end; { procedure ReadParams }
  66.  
  67. procedure TUpdFiles.UpdateFiles;
  68. var
  69.   AreaRec          : Area_Config_Record;
  70.   DirRec           : Area_Directory_Record;
  71.   FileRec          : TFileRec;
  72.   FPos             : LongInt;
  73.   SRec             : SearchRec;
  74.   Changed          : Boolean;
  75.   OldSize          : LongInt;
  76.   OldDate          : T_Date;
  77.   FilePath         : string;
  78.  
  79. {}procedure ScanCD( FromDir : string );
  80.   type
  81.     OneDirType     = array[0..1999] of string[12];
  82.   var
  83.     ThisDir        : ^OneDirType;
  84.     SR             : SearchRec;
  85.     RecNo          : Word;
  86.     TempStr        : string;
  87.   begin
  88.     New( ThisDir );
  89.     FillChar( ThisDir^, SizeOf( ThisDir^ ), 0 );
  90.     RecNo := 0;
  91.     FindFirst( FromDir + '\*.*', AnyFile, SR );
  92.     while ( DosError = 0 ) do
  93.     begin
  94.       if not ( SR.Name = '.' ) and
  95.          not ( SR.Name = '..' ) and
  96.          ( SR.Attr and Directory = Directory ) then
  97.       begin
  98.         ThisDir^[RecNo] := SR.Name;
  99.         Inc( RecNo );
  100.       end;
  101.       FindNext( SR );
  102.     end;
  103.  
  104.     RecNo := 0;
  105.     while not ( ThisDir^[RecNo] = '' ) do
  106.     begin
  107.       ScanCD( FromDir + '\' + ThisDir^[RecNo] );
  108.       with FileRec do
  109.         if FileExist( Copy( FromDir, 1, 3 ) + CDPath ) and
  110.            FindStr( FileName, CDPath ) then Break;
  111.  
  112.       Inc( RecNo );
  113.     end;
  114.     Dispose( ThisDir );
  115.  
  116.     if FileExist( FromDir + '\' + FileRec.FileName ) then
  117.     begin
  118.       with FileRec do
  119.         CDPath := Copy( FromDir, 4, Length( FromDir )) + '\' + FileRec.FileName;
  120.     end;
  121. {}end; { function ScanCD }
  122.  
  123. {}function  Autofix : Boolean;
  124.   var
  125.     CDLoop         : Byte;
  126.     Dirloop        : LongInt;
  127.     Fixed          : Boolean;
  128.   begin
  129.     with FileRec do
  130.     begin
  131.       if not ( CDPath = '' ) then
  132.         for CDLoop := 1 to 10 do
  133.         begin
  134.           FindFirst( Cfg.CDROM[CDLoop] + ':\' + CDPath, AnyFile, SRec );
  135.           if ( DosError = 0 ) then
  136.           begin
  137.             CDROM := CDLoop;
  138.             Autofix := TRUE;
  139.             Exit;
  140.           end;
  141.         end;
  142.  
  143.       DirLoop := 0;
  144.       while fioReadDirCfg( DirRec, AreaRec, DirLoop ) do
  145.       begin
  146.         FindFirst( DirRec.DiskDir + '\' + FileName, AnyFile, SRec );
  147.         if ( DosError = 0 ) then
  148.         begin
  149.           DirNo := DirRec.DirNo;
  150.           CDROM := 0;
  151.           Autofix := TRUE;
  152.           Exit;
  153.         end;
  154.  
  155.         Inc( DirLoop );
  156.       end;
  157.  
  158.       if ( CheckAction = actAutofixLong ) then
  159.         for CDLoop := 1 to 10 do
  160.         begin
  161.           if ( Cfg.CDROM[CDLoop] in ['A'..'Z'] ) then
  162.           begin
  163.             ScanCD( Cfg.CDROM[CDLoop] + ':' );
  164.             with FileRec do
  165.               if FileExist( Cfg.CDROM[CDLoop] + ':\' + CDPath ) and
  166.                  FindStr( FileName, CDPath ) then
  167.               begin
  168.                 CDROM := CDLoop;
  169.                 Autofix := TRUE;
  170.                 Exit;
  171.               end;
  172.           end;
  173.         end;
  174.  
  175.       Autofix := FALSE;
  176.     end;
  177. {}end; { function Autofix }
  178.  
  179. begin
  180.   if SkipSize or SkipDate then
  181.   begin
  182.     if SkipSize then Writeln( '- No size update will be done' );
  183.     if SkipDate then Writeln( '- No date update will be done' );
  184.   end
  185.   else Writeln( '- Both size and date will be updated' );
  186.   if CheckExist then
  187.   begin
  188.     case CheckAction of
  189.       actAutofix: Writeln( '- Check files, attempt to autofix' );
  190.       actAutofixLong: Writeln( '- Check files, attempt to autofix, scan CD''s' );
  191.       actDelete: Writeln( '- Check files, delete if not found' );
  192.     end;
  193.   end;
  194.   fioFindAreaCode( AreaRec, AreaCode, 0 );
  195.   Writeln( '- Searching for files in ' + AreaRec.AreaName );
  196.   Writeln;
  197.  
  198.   FPos := 0;
  199.   while fioReadFileRec( FileRec, AreaRec, FPos ) do
  200.   begin
  201.     Inc( FPos );
  202.     if ( KilledFile in FileRec.FileFlags ) then Continue;
  203.  
  204.     with FileRec do
  205.     begin
  206.       if LookInIf( UpStr( FileName ), FileSpec ) then
  207.       begin
  208.         Changed := FALSE;
  209.         Write( Fill( FileName, 16, ' ' ));
  210.  
  211.         if fioFindDirNo( DirRec, DirNo, AreaRec, 0 ) then
  212.         begin
  213.           if ( CDROM = 0 ) then FilePath := DirRec.DiskDir + '\' + FileName
  214.           else FilePath := Cfg.CDROM[CDROM] + ':\' + CDPath;
  215.  
  216.           if FileExist( FilePath ) then
  217.           begin
  218.             FindFirst( FilePath, AnyFile, SRec );
  219.  
  220.             if not SkipSize then
  221.             begin
  222.               OldSize := Size;
  223.               Size := SRec.Size;
  224.  
  225.               if ( OldSize <> Size ) then
  226.               begin
  227.                 Write( '  ', Size:10, '>', SRec.Size:10 );
  228.                 Changed := TRUE;
  229.               end;
  230.             end;
  231.  
  232.             if not SkipDate then
  233.             begin
  234.               OldDate := Date.Date;
  235.               with Date.Date do
  236.                 Bits.Date( Year, Month, Day );
  237.               if not ( LongInt( OldDate ) = LongInt( Date.Date )) then
  238.               begin
  239.                 with Date.Date do
  240.                   Write( '  ', I2S( Day, 2 ) + I2S( Month, 2 ) + I2S( Year, 4 ) +'>' );
  241.                 with OldDate do
  242.                   Write( I2S( Day, 2 ) + I2S( Month, 2 ) + I2S( Year, 4 ));
  243.                 Changed := TRUE;
  244.               end;
  245.             end;
  246.           end
  247.           else
  248.           begin
  249.             Write( '  not found' );
  250.             if CheckExist then
  251.             begin
  252.               case CheckAction of
  253.                 actAutofix,
  254.                 actAutofixLong:
  255.                 begin
  256.                   if Autofix then
  257.                   begin
  258.                     Write( ', path fixed' );
  259.                     Changed := TRUE;
  260.                   end
  261.                   else Write( ', unable fix path' );
  262.                 end;
  263.                 actDelete:
  264.                 begin
  265.                   FileFlags := FileFlags + [KilledFile];
  266.                   Write( ', killed' );
  267.                   Changed := TRUE;
  268.                 end;
  269.               end;
  270.             end;
  271.           end;
  272.         end
  273.         else
  274.           Write( '  can''t find directory' );
  275.  
  276.         if Changed then
  277.         begin
  278.           fioWriteFileRec( FileRec, AreaRec, FileRec.RecPos );
  279.           Write( '  updated' );
  280.         end;
  281.  
  282.         if ( WhereX = 17 ) then Write( Fill( '', 16, #8 ))
  283.         else Writeln( '.' );
  284.       end;
  285.     end;
  286.   end;
  287. end; { procedure UpdateFile }
  288.  
  289. begin
  290.   Writeln;
  291.   Writeln('UpdFile v1.05 - Update file date and size information in FOSS/2 filedatabase');
  292.   Writeln;
  293.  
  294.   if not ( Par^.Count = 1 ) then
  295.   begin
  296.     Writeln( 'Usage:' );
  297.     Writeln( '   UPDFILE {{-C[D|P]}|{-D} {-S}} {-A[area]} [filespec]' );
  298.     Writeln;
  299.     Writeln( '   -CD          Check if file(s) exists, delete files not found' );
  300.     Writeln( '   -CA          Check if file(s) exists, attempt to fix files not found' );
  301.     Writeln( '   -CL          Check